#*************************************************************************
#*
#*  $RCSfile$
#*
#*  $Revision$
#*
#*  last change: $Author: wiede $ $Date: 2005-10-19 17:46:51 +0200 (Wed, 19 Oct 2005) $
#*
#*  The Contents of this file are made available subject to the terms of
#*  the following license
#*
#* 	- BSD License
#*
#*	see file license/license.terms in this directory
#*
#*  Copyright 2005 Wolfgang Grosser
#*
#*  Author: Wolfgang Grosser
#*
#*  Contributor(s): 
#*
#************************************************************************/

package require vfs
package require vfs::zip
package require vfs::tar

namespace eval ::tcluno_interface_info {

variable library [file dirname [info script]]
variable initted 0
variable interface_modules
variable interface_interfaces
variable interface_interface_infos
variable interface_method_infos
variable unknown_interface_info "???"

proc InitTypeInfos {} {
	variable interface_modules
	variable interface_interfaces
	variable interface_interface_infos
	variable interface_method_infos
	variable library

	set vfs_type tar
	if {$::tcluno_interface_info::initted} {
		return
	}
	set fd [::vfs::${vfs_type}::Mount $library/tcluno_interface_infos_all.$vfs_type ti]
	foreach type "interface" {
		set utype [string toupper $type]
		set modules [::${vfs_type}::getdir $fd . METHOD_INFOS/$utype/*]
		set ${type}_modules [lsort $modules]
		foreach module $modules {
			set interfaces [::${vfs_type}::getdir $fd . METHOD_INFOS/$utype/$module/*]
			set ${type}_interfaces($module) [lsort $interfaces]
			foreach interface $interfaces {
				set interface_fd [vfs::${vfs_type}::open $fd METHOD_INFOS/$utype/$module/$interface r ""]
				set lst [list]
				regsub -all {::} $module {.} my_module
				while {[gets $interface_fd line] > 0} {
#puts stderr "FI2:$line:"
					lappend lst $line
					foreach {type_str value} $line break
					switch -glob -- $type_str {
					"method#*" {
						if {![info exist ${type}_method_infos($value)]} {
							set ${type}_method_infos($value) [list]
						}
					  	lappend ${type}_method_infos($value) $my_module.$interface
					  }
					}
				}
				set ${type}_interface_infos($my_module.$interface) $lst
			}

		}

	}
	vfs::filesystem unmount ti
	set ::tcluno_interface_info::initted 1
}

proc getInterfaceModules {} {
	variable interface_modules

	InitTypeInfos
	return $interface_modules
}

proc getInterfaceInterfaces {module_name} {
	variable interface_interfaces
	variable unknown_interface_info

	InitTypeInfos
	if {![info exists interface_interfaces($module_name)]} {
		return $unknown_interface_info
	}
	return $interface_interfaces($module_name)
}

proc getInterfaceInterfaceInfos {interface_name} {
	variable interface_interface_infos
	variable unknown_interface_info

	InitTypeInfos
	if {![info exists interface_interface_infos($interface_name)]} {
		return $unknown_interface_info
	}
	return $interface_interface_infos($interface_name)
}

proc getInterfaceMethodInfos {method_name} {
	variable interface_method_infos
	variable unknown_interface_info

	InitTypeInfos
	if {![info exists interface_method_infos($method_name)]} {
		return $unknown_interface_info
	}
	return $interface_method_infos($method_name)
}

proc unknown_interface_info {} {
	variable unknown_interface_info
	return $unknown_interface_info
}

}

package provide tcluno_interface_info 0.0
